Roadway and footpath data for Cook County were obtained from
OpenStreetMap, and GTFS feeds for public transportation (timetables,
routes, and service details) were downloaded from the CTA, Metra, and
PACE websites. These inputs were used in r5r to build a multimodal
routing network. Trip parameters included a maximum walking time of 30
minutes, maximum total travel time of 2 hours, and a departure window of
November 19, 2025 at 09:00 ± 10 minutes. Origins were defined as
population centroids of each census block group, and destinations as all
level I trauma centers.
For each origin–destination pair, r5r generated multiple feasible
public transit itineraries. Average travel time, wait time, walking
time, number of transfers, and number of modal “legs” (walk, bus, train)
were calculated by aggregating across all itineraries within the time
window. Drive times were estimated separately using the road network,
assuming typical traffic for the specified departure time.
Because this process produced a very large set of origin–destination
combinations, each block group was ultimately assigned to a single
trauma center based on the minimum drive time. The minimum drive time
was chosen to approximate the trauma center that would be closest to
each block group if resident was transported by EMS.
The following code depicts the above. This code is complex and
computations took several hours given the magnitude of
origin-destination pairs. Therefore, the code is displayed below for
reference but will not run. The output is saved as an RData file for
direct use in subsequent sections. A sample of the output of this file
is shown below.
###--------------------------------Data--------------------------------------###
# A road network data set from OpenStreetMap in .pbf format (mandatory)
# A public transport feed in GTFS.zip format
setwd("~/Desktop/GIS")
load('base_maps.RData')
load('origins-destinations.RData')
###--------------------------Route Construction------------------------------###
data_path <- "~/Desktop/GIS/transit_files"
#list.files(data_path)
r5r_network <- build_network(data_path = data_path)
###--------------------------------Test--------------------------------------###
#read dates
# read the GTFS feed
#gtfs_CTA <- read_gtfs('~/Desktop/GIS/transit_files/CTA.zip')
#gtfs_Metra <- read_gtfs('~/Desktop/GIS/transit_files/Metra.zip')
#gtfs_PACE <- read_gtfs('~/Desktop/GIS/transit_files/PACE.zip')
# get calendar dates (from calendar.txt)
#calendar_dates <- gtfs_CTA$calendar
origin <- data.frame(id = '474 N Lakeshore',
lat = as.numeric(41.89108953920192),
lon = as.numeric(-87.61458686048464))
origin <- data.frame(id = 'Millenium Station',
lat = as.numeric(41.884589597182945),
lon = as.numeric(-87.6247049739245))
# set departure datetime input
mode <- c("WALK", 'TRANSIT')
max_walk_time <- 30 # minutes
max_trip_duration <- 120 # minutes
departure_datetime <- as.POSIXct("19-11-2025 09:00:00",
format = "%d-%m-%Y %H:%M:%S")
ttm_test <- travel_time_matrix(
r5r_network,
origins = origin,
destinations = ucm,
mode = mode,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
max_trip_duration = max_trip_duration
)
# calculate detailed itineraries
ttm_test <- detailed_itineraries(
r5r_network,
origins = origin,
destinations = ucm,
mode = mode,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
###-------------------------Transit Time Analysis----------------------------###
#create origins data frame
chi_bgcentroids$id <- chi_bgcentroids$GEOID
origin <- chi_bgcentroids %>%
select(id, geometry)
st_crs(origin) #needs to be WGS 84
#create destinations data frame
adult_level_one$id <- adult_level_one$facility
destination <- adult_level_one %>%
select(id, geometry)
st_crs(destination) #needs to be WGS 84
#UCM travel time matrix
ucm <- destination %>%
filter(id == 'University of Chicago Emergency Department and Trauma Center')
ttm_ucm <- detailed_itineraries(
r5r_network,
origins = origin,
destinations = ucm,
mode = mode,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
#Christ travel time matrix
christ <- destination %>%
filter(id == 'Advocate Christ Medical Center')
ttm_christ <- detailed_itineraries(
r5r_network,
origins = origin,
destinations = christ,
mode = mode,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
#Masonic travel time matrix
masonic <- destination %>%
filter(id == 'Advocate Illinois Masonic Medical Center')
ttm_masonic <- detailed_itineraries(
r5r_network,
origins = origin,
destinations = masonic,
mode = mode,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
#County travel time matrix
county <- destination %>%
filter(id == 'John H. Stroger, Jr. Hospital of Cook County')
ttm_county <- detailed_itineraries(
r5r_network,
origins = origin,
destinations = county,
mode = mode,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
#NWM travel time matrix
nwm <- destination %>%
filter(id == 'Northwestern Memorial Hospital')
ttm_nwm <- detailed_itineraries(
r5r_network,
origins = origin,
destinations = nwm,
mode = mode,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
#St. Francis time matrix
sfh <- destination %>%
filter(id == 'Ascension Saint Francis - Emergency Room')
ttm_sfh <- detailed_itineraries(
r5r_network,
origins = origin,
destinations = sfh,
mode = mode,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
#Mount Sinai time matrix
msh <- destination %>%
filter(id == 'Mount Sinai Hospital')
ttm_msh <- detailed_itineraries(
r5r_network,
origins = origin,
destinations = msh,
mode = mode,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
#Loyola travel time matrix
loyola <- destination %>%
filter(id == 'Loyola University Medical Center')
ttm_loyola <- detailed_itineraries(
r5r_network,
origins = origin,
destinations = loyola,
mode = mode,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
#Lutheran travel time matrix
lutheran <- destination %>%
filter(id == 'Advocate Lutheran General Hospital')
ttm_lutheran <- detailed_itineraries(
r5r_network,
origins = origin,
destinations = lutheran,
mode = mode,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
###-------------------------Drive Time Analysis----------------------------###
#set mode to drive
mode <- c("CAR")
#UCM travel time matrix
dtm_ucm <- detailed_itineraries(
r5r_network,
origins = origin,
destinations = ucm,
mode = mode,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
#Christ travel time matrix
christ <- destination %>%
filter(id == 'Advocate Christ Medical Center')
dtm_christ <- detailed_itineraries(
r5r_network,
origins = origin,
destinations = christ,
mode = mode,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
#Masonic travel time matrix
masonic <- destination %>%
filter(id == 'Advocate Illinois Masonic Medical Center')
dtm_masonic <- detailed_itineraries(
r5r_network,
origins = origin,
destinations = masonic,
mode = mode,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
#County travel time matrix
county <- destination %>%
filter(id == 'John H. Stroger, Jr. Hospital of Cook County')
dtm_county <- detailed_itineraries(
r5r_network,
origins = origin,
destinations = county,
mode = mode,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
#NWM travel time matrix
nwm <- destination %>%
filter(id == 'Northwestern Memorial Hospital')
dtm_nwm <- detailed_itineraries(
r5r_network,
origins = origin,
destinations = nwm,
mode = mode,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
#St. Francis time matrix
sfh <- destination %>%
filter(id == 'Ascension Saint Francis - Emergency Room')
dtm_sfh <- detailed_itineraries(
r5r_network,
origins = origin,
destinations = sfh,
mode = mode,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
#Mount Sinai time matrix
msh <- destination %>%
filter(id == 'Mount Sinai Hospital')
dtm_msh <- detailed_itineraries(
r5r_network,
origins = origin,
destinations = msh,
mode = mode,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
#Loyola travel time matrix
dtm_loyola <- detailed_itineraries(
r5r_network,
origins = origin,
destinations = loyola,
mode = mode,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
#Lutheran travel time matrix
dtm_lutheran <- detailed_itineraries(
r5r_network,
origins = origin,
destinations = lutheran,
mode = mode,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
###--------------------Creating a Simplified Data Frame----------------------###
#below is a function that process the public transit data into one observation
#per origin-destination pair
process_ttm <- function(df) {
df2 <- df %>%
mutate(
walk = if_else(mode == "WALK", 1, 0),
transfer = if_else(wait > 0, 1, 0),
bus = if_else(mode == "BUS", 1, 0),
cta_train = if_else(mode == "SUBWAY", 1, 0),
metra_train = if_else(mode == "RAIL", 1, 0)
)
walk_summary <- df2 %>%
st_drop_geometry() %>%
filter(mode == "WALK") %>%
group_by(from_id, option) %>%
summarise(
total_walk_time = sum(segment_duration, na.rm = TRUE),
total_walk_distance = sum(distance, na.rm = TRUE),
.groups = "drop"
)
wait_summary <- df2 %>%
st_drop_geometry() %>%
group_by(from_id, option) %>%
summarise(
wait_total = sum(wait, na.rm = TRUE),
total_transfers = sum(transfer, na.rm = TRUE),
total_bus_trips = sum(bus, na.rm = TRUE),
total_cta_train_trips = sum(cta_train, na.rm = TRUE),
total_metra_train_trips = sum(metra_train, na.rm = TRUE),
number_of_legs = n(),
.groups = "drop"
)
df3 <- df2 %>%
left_join(walk_summary, by = c("from_id", "option")) %>%
left_join(wait_summary, by = c("from_id", "option"))
final <- df3 %>%
st_drop_geometry() %>%
group_by(from_id, to_id) %>%
summarise(
number_of_options = max(option),
avg_tt = mean(total_duration, na.rm = TRUE),
avg_td = mean(total_distance, na.rm = TRUE),
avg_walk_time = mean(total_walk_time, na.rm = TRUE),
avg_walk_dist = mean(total_walk_distance, na.rm = TRUE),
avg_wait_time = mean(wait_total, na.rm = TRUE),
avg_transfers = mean(total_transfers, na.rm = TRUE),
avg_bus_trips = mean(total_bus_trips, na.rm = TRUE),
avg_cta_train_trips = mean(total_cta_train_trips, na.rm = TRUE),
avg_metra_train = mean(total_metra_train_trips, na.rm = TRUE),
avg_legs = mean(number_of_legs, na.rm = TRUE),
.groups = "drop"
)
final <- final %>%
rename(GEOID = from_id)
return(final)
}
transit_ucm <- process_ttm(ttm_ucm)
transit_christ <- process_ttm(ttm_christ)
transit_county <- process_ttm(ttm_county)
transit_loyola <- process_ttm(ttm_loyola)
transit_lutheran <- process_ttm(ttm_lutheran)
transit_masonic <- process_ttm(ttm_masonic)
transit_msh <- process_ttm(ttm_msh)
transit_nwm <- process_ttm(ttm_nwm)
transit_sfh <- process_ttm(ttm_sfh)
#merged data
final_christ <- transit_christ %>%
full_join(dtm_christ_clean, by = "GEOID")
final_county <- transit_county %>%
full_join(dtm_county_clean, by = "GEOID")
final_loyola <- transit_loyola %>%
full_join(dtm_loyola_clean, by = "GEOID")
final_lutheran <- transit_lutheran %>%
full_join(dtm_lutheran_clean, by = "GEOID")
final_masonic <- transit_masonic %>%
full_join(dtm_masonic_clean, by = "GEOID")
final_msh <- transit_msh %>%
full_join(dtm_msh_clean, by = "GEOID")
final_nwm <- transit_nwm %>%
full_join(dtm_nwm_clean, by = "GEOID")
final_sfh <- transit_sfh %>%
full_join(dtm_sfh_clean, by = "GEOID")
final_ucm <- transit_ucm %>%
full_join(dtm_ucm_clean, by = "GEOID")
###------------------Creating closest drive time data frame--------------------###
#create mega data frame
final_combo <- bind_rows(final_christ,
final_county,
final_loyola,
final_lutheran,
final_masonic,
final_msh,
final_nwm,
final_sfh,
final_ucm)
#only keep closest by drive time
min_drive <- final_combo %>%
group_by(GEOID) %>%
slice_min(drive_time, with_ties = FALSE) %>%
ungroup()
#combine with block group shapefiles
final_min_time <- chi_bgs %>%
left_join(min_drive, by = 'GEOID')
